home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / FGL304F.ZIP;1 / EXFOR.ARJ / FGDOC / EXAMPLES / FORTRAN / 05-16.FOR < prev    next >
Encoding:
Text File  |  1994-01-24  |  1.9 KB  |  91 lines
  1. $INCLUDE: 'C:\FG\INTRFACE.FOR'
  2.  
  3.       PROGRAM MAIN
  4.  
  5.       INTEGER*2 MODE, OLD_MODE
  6.       CHARACTER*5 STRING
  7.       INTEGER*2 FG_GETMODE, FG_TESTMODE
  8.  
  9. C  Ask for the video mode number
  10.  
  11.       WRITE(6,*) 'Which video mode?'
  12.       READ(5,*) MODE
  13.  
  14. C  Make sure the entered value is valid
  15.  
  16.       IF (MODE .LT. 0 .OR. MODE .GT. 29) THEN
  17.          WRITE(6,1000) MODE
  18.          STOP ' '
  19.       END IF
  20.  
  21. C  Make sure the requested video mode is available
  22.  
  23.       IF (FG_TESTMODE(MODE,1) .EQ. 0) THEN
  24.          WRITE(6,1010) MODE
  25.          STOP ' '
  26.       END IF
  27.  
  28. C  Establish the video mode
  29.  
  30.       OLD_MODE = FG_GETMODE()
  31.       CALL FG_SETMODE(MODE)
  32.  
  33. C  Perform mode-specific initializations
  34.  
  35. C  text modes
  36.  
  37.       IF (MODE .LE. 3 .OR. MODE .EQ. 7) THEN
  38.          CALL FG_CURSOR(0)
  39.  
  40. C  CGA color modes
  41.  
  42.       ELSE IF (MODE .EQ. 4 .OR. MODE .EQ. 5) THEN
  43.          CALL FG_PALETTE(0,0)
  44.          CALL FG_DEFCOLOR(14,3)
  45.  
  46. C  CGA two-color mode
  47.  
  48.       ELSE IF (MODE .EQ. 6) THEN
  49.          CALL FG_PALETTE(0,14)
  50.          CALL FG_DEFCOLOR(14,1)
  51.  
  52. C  Hercules mode
  53.  
  54.       ELSE IF (MODE .EQ. 11) THEN
  55.          CALL FG_DEFCOLOR(14,1)
  56.  
  57. C  Hercules low-res mode
  58.  
  59.       ELSE IF (MODE .EQ. 12) THEN
  60.          CALL FG_DEFCOLOR(14,3)
  61.  
  62. C  VGA two-color mode
  63.  
  64.       ELSE IF (MODE .EQ. 17) THEN
  65.          CALL FG_PALETTE(1,14)
  66.          CALL FG_SETRGB(14,63,63,21)
  67.          CALL FG_DEFCOLOR(14,1)
  68.       END IF
  69.  
  70. C  Display a message that includes the video mode number
  71.  
  72.       CALL FG_SETCOLOR(14)
  73.       CALL FG_TEXT('I''m running in mode ',20)
  74.       WRITE(STRING,1020) MODE
  75.       CALL FG_TEXT(STRING,3)
  76.  
  77. C  Wait for a keystroke
  78.  
  79.       CALL FG_WAITKEY
  80.  
  81. C  Restore the original video mode and screen attributes
  82.  
  83.       CALL FG_SETMODE(OLD_MODE)
  84.       CALL FG_RESET
  85.  
  86.       STOP ' '
  87. 1000  FORMAT(I6,' is not a valid video mode number.')
  88. 1010  FORMAT(' Mode ',I2,' is not available on this system.')
  89. 1020  FORMAT(I2,'.')
  90.       END
  91.